00100	C   SCORB.F4   2ND HALF OF SCORE.
00200		SUBROUTINE RUNIT
00300		COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
00400		1 ,LN,ITYP,TPALN,JED
00500		COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
00600		1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00700		1 ,P1(27),JFM(4),COPY(30),IFM(80)
00800		1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
00900		DIMENSION IV(2000),IT(30),IOUT(70),JPT(837),NCNT(27,32)
01000	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
01100	C   40 LIT CHARS + 30 PARAMS PER INST.
01200	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
01300		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
01400		1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01500		1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01600		COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01700		1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01800		1 CHN,YY 
01900		1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02000		1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,IL,
02100		1 KODE,RD,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,NPAR,
02200		1 VIJ2
02300	C  /C/=26
02400		EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
02500		1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPT,JPT)
02600		1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
02700		1 ,(VX5,VX(5)),(VX,IOUT),(IFM3,IFM(3))
02800		1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
02900		1 ,(IFM4,IFM(4))
03000	      DATA SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
03100		1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
03200		1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
03300		1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
03400		1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
03500		1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
03600		1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
03700		1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
03800		1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
03900		1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
04000		1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
04100		1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
04200		PR=0
04300	2337	T=0
04400		DO 1107 K=1,30
04500	1107	PL(K)=1.
04600	C  2/74--WAS AT 17300/1   SETS DEFAULT OUTPUT MODE TO 1.
04700		IF(ITYP)GO TO 23371
04800		END FILE 21
04900		DATA ENFI /25H(' INPUT ON FOR21.DAT '/)/
05000		TYPE ENFI
05100	C  PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
05200	23371	IF(SOS)WRITE(JOUT,902)
05300	C   WRITES A BLANK LINE
05400		NWZZ=0
05500		IAMP=0
05600		IT3=0
05700		K=1
05800	      IX=0  
05900		BG(NINS+1)=19999.
06000	4011	IF(CNT(K))GO TO 5011
06100	6011	IF(K.EQ.KZY)GO TO 4337
06200		K=K+1
06300		GO TO 4011
06400	5011	L=V(I-1)/(-9900.)
06500		IF(L.EQ.1)I=I-1
06600		V(I)=CNT(K)
06700		V(I+1)=P(K)
06800		V(I+3)=-44.
06900		I=I+5
07000		IF(P(K).EQ.980000.)I=I-4
07100		KL=I
07200		REWIND 1
07300		ICT=IPT(K,1)
07400		CALL IFILE(1,ICT)
07500	9011	L=I+6
07600		READ(1,7011)(V(M),M=I,L)
07700	C   READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
07800		IF(V(L).EQ.999.)GO TO 8011
07900		I=L+1
08000		GO TO 9011
08100	8011	IF(P(K).NE.980000.)GO TO 6337
08200		DO 7337 K=L,I,-1
08300	7337	IF(V(K).NE.999.)GO TO 8337
08400	8337	I=K-1
08500		V(I)=0
08600		V(I+1)=V(K)
08700		V(I+2)=V(K)
08800	C   K WAS I-1 ABOVE.
08900		I=I+3
09000		V(KL+1)=I-KL-1
09100	C  ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
09200		GO TO 4337
09300	6337	DO 5337 M=I,L
09400		KN=M
09500	5337	IF(V(M).EQ.999.)GO TO 3337
09600	3337	I=KN
09700		KN=I-KL
09800		V(KL-1)=KN
09900		V(KL-3)=KN+3
10000		GO TO 6011
10100	7011	FORMAT(7F)
10200	4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
10300		V(I)=-19899.
10400	      PP1=0
10500	      T6=10000.   
10600	      DO 2118 K=1,NINS  
10700		ROFF(K)=0
10800	C********* FEB 17,71
10900		M=NP(K)
11000	      IT(K)=0 
11100		IPT(K,31)=0
11200		NCNT(K,31)=1
11300		DO 2118 L=1,M
11400		NCNT(K,L)=1
11500	2118	IPT(K,L)=0
11600		DO 5013 K=1,IXIN
11700	5013	X=RAND(0.0,0.0)
11800		REWIND 1
11900		IF(MX)CALL OFILE(1,ISLAC)
12000	      NW=1    
12100		NWX=0
12200	      TDUR=0
12300		A=0
12400	      T2=1. 
12500	      T4=1. 
12600	      T5=0  
12700		J=1
12800	      MK=0  
12900	C   IS THE ABOVE NEEDED?
13000		IF(MX.NE.3)GO TO 40021
13100		K=4
13200	10023	N=AMOD(V(K),100.0)/-11.
13300	C  AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
13400		IF(N.EQ.2)GO TO 77
13500		IF(N.EQ.3)GO TO 77
13600		IF(N.NE.4)GO TO 10021
13700	77	IF(V(K-2).LT.10000.)GO TO 10021
13800		J=V(K+1)
13900		IF(J.EQ.1)GO TO 10024
14000		IF(N.NE.3)GO TO 177
14100		IF(V(K+J+1).EQ.101.)J=J-1
14200	177	N=V(K-2)
14300		L=N/10000
14400		M=N-L*10000
14500		TYPE 10022,INST(L),M,J
14600	10024	K=K+ABS(V(K-1))
14700	10021	K=K+1
14800		IF(K.LT.I)GO TO 10023
14900	40021	IF(MZ.NE.-4)GO TO 1002
15000		N=1
15100	40022	K=N+1
15200		IF(N.GT.I)CALL EXIT
15300		X=V(N)
15400		IF(X.EQ.-199.)GO TO 40024
15500		IF(X.EQ.-99.)GO TO 40024
15600		IF(X.GE.0)GO TO 40023
15700		PRINT 4002,X
15800		N=N+1
15900		GO TO 40022
16000	40024	J=N+1
16100		GO TO 40025
16200	C  FOR 'SECTIONS'
16300	40023	J=ABS(V(K))+K-1
16400	40025	PRINT 4002,(V(K),K=N,J)
16500		N=J+1
16600		GO TO 40022
16700	10022	FORMAT(1XA5,' P',I2,'  HAS ',I3,' ITEMS.')
16800	4002  FORMAT(10F12.3)
16900	1002	IF(IDALL)GO TO 600
17000		X=DUR(IDALL)
17100		DO 2002 K=1,NINS
17200	2002	IF(DUR(K))DUR(K)=X
     

00100	C ***** SORTER *************************  
00200	C  *******  OUTPUT LOOP FROM HERE ON  ********
00300	600      IL=0     
00400	C********** BELOW IS FOR 'SECTIONS'
00500		KODE=0
00600		NWX=NWX+1
00700	      MK=MK+1     
00800	      Y=BNW(NW)   
00900	723      IL=IL+1  
01000	3723      Z=V(IL)     
01100	      IF(Z.EQ.-19899.)GO TO 732
01200	      IF(Z.NE.-9900.-Y)GO TO 723     
01300	C********** BELOW IS FOR 'SECTIONS'
01400		IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500	2723      IL=IL+1   
01600	729	K=IL+2
01700		MOT=V(IL+1)
01800		RD=V(K)
01900		IF(RD.EQ.-67.)GO TO 3726
02000		RB=V(IL)
02100	C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200		IF(RB.NE.-99.)GO TO 4150
02300		KODE=IV(K-1)
02400	2160	IF(KODE.EQ.0)GO TO 723
02500	  	IF(MZ)WRITE(JOUT,9150),KODE
02600		KL=Y/10000.
02700		RB=Y+KL*10000.
02800		DO 5150 KL=1,I
02900		IF(V(KL).NE.-199.)GO TO 5150
03000		IF(IV(KL+1).NE.KODE)GO TO 5150
03100		IV(K-1)=0
03200	C  WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03300		RD=V(KL+2)+9900.
03400		DO 6150 L=KL+2,I
03500		M=V(L)/(-9900.)
03600		IF(M.NE.1)GO TO 6150
03700		RA=RB+RD-V(L)-9900.
03800		V(L)=-9900.-RA
03900	C  UPDATES BG TIMES INSIDE SECTION.
04000		CALL BGSORT(RA)
04100	C7150	IF(RA.EQ.BNW(KA))GO TO 6150
04200	C  UPDATES LIST OF CHANGE TIMES.
04300	6150	IF(V(L).EQ.-299.)GO TO 160
04400	5150	CONTINUE
04500	160	IL=1
04600		GO TO 3723
04700	C***********  ABOVE IS FOR 'SECTION' REPEATS
04800	4150	LK=RB/10000.+.2
04900		IF(LK.GE.98)GO TO 7700
05000		LP=RB-LK*10000
05100	C   LK=INST #   LP=PARAM #
05200		LN=IPT(LK,LP)
05300		IPT(LK,LP)=IL+2
05400		IF(RD.EQ.-66.)GO TO 726
05500		IF(RD.EQ.-55.)GO TO 1726
05600		IF(RD.EQ.-56.)GO TO 1726
05700		IF(RD.EQ.-23)GO TO 6700
05800	
05900	2727	ML=IPT(LK,LP)
06000		IF(MOT.GT.0)GO TO 3727
06100	C  USE NEG WDCNT FOR 'ALL'
06200		DO 4727 KL=LK+1,NINS
06300		IF(NP(KL).GE.LP)GO TO 277
06400		IF(LP.LT.31)NP(KL)=LP
06500	277	IPT(KL,LP)=-(LK+(LP-1)*KZY)
06600		NCNT(KL,LP)=10000
06700	4727	IF(DUR(KL))DUR(KL)=1000.
06800	C  ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06900	C  AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
07000		GO TO 727
07100	C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
07200	3727	IF(V(IL).NE.V(LN-1))GO TO 727
07300		IF(LN.EQ.0)GO TO 727
07400		DO 1727 L=1,NINS
07500		DO 1727 KL=1,NP(L)
07600		IF(LN.NE.IPT(L,KL))GO TO 1727
07700		NCNT(L,KL)=10000
07800	C ******* JAN 29,70
07900		IPT(L,KL)=ML
08000	C RESETS POINTERS FOR DUPL AND REP INSTS.
08100	C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
08200	1727	CONTINUE
08300	727	NCNT(LK,LP)=10000
08400	C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08500	2150	IF(MOT)MOT=-MOT
08600		IL=IL+MOT+1
08700	3150	IF(V(IL))GO TO 3723
08800		GO TO 729
08900	726	RB=V(IL+3)
09000		K=RB/10000.
09100		L=RB-K*10000
09200		IPT(LK,LP)=-(K+(L-1)*KZY)
09300		GO TO 2727
09400	3726	LK=V(IL)
09500		M=V(K+1)
09600		KL=NP(M)
09700		DO 4726 L=1,KL
09800		IPT(LK,L)=IPT(M,L)
09900		IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
10000	C****** JUN 29 71  (LK,L) WAS (L,K)....???????
10100	4726	CONTINUE
10200		IPT(LK,31)=IPT(M,31)
10300		K=0
10400		GO TO 2150
10500	C   ABOVE IS FOR DUPLICATION ROUTINE   NEXT ADJUSTS TIMES FOR 'RTAP'
10600	6700	KL=IL+V(IL+1)+1.3
10700		RC=V(K-2)
10800	1770	IF(V(KL))GO TO 700
10900	2700	KL=KL+V(KL+1)+1.3
11000		GO TO 1770
11100	700	KL=KL+1
11200		IF(Z.NE.V(KL-1))GO TO 2700
11300		IF(V(KL).NE.RC)GO TO 2700
11400		KL=KL+3
11500		KN=IL+3
11600		LN=V(KN)+.3
11700		DO 3700 L=1,LN,2
11800		RA=V(L+KN)
11900		KA=V(L+KN+1)+.3
12000		RB=0
12100		DO 4700 LP=1,KA
12200	4700	RB=RB+V(KL+LP)
12300		DO 5700 LP=1,KA
12400	5700	V(KL+LP)=V(KL+LP)/RB*RA
12500		V(KL+KA)=V(KL+KA)+.00030
12600	3700	KL=KL+KA
12700		GO TO 2150
12800	
12900	C  BELOW FOR 'TEMPO' SETUP
13000	7700	T2=V(IL+4)
13100		T1=V(IL+3)
13200		TBG=Y
13300		TDUR=V(IL+2)
13400		CALL SQYY(AC,T1,T2,TDUR)
13500	8700	IF(TDUR.EQ.0)TDUR=10000.
13600		T5=1.
13700		T6=TBG+TDUR
13800		IT3=1.
13900		IF(LK.EQ.98)IT3=IL+2
14000		T4=1.
14100		GO TO 2150
14200	C*************** ANY WDCNTS DOWN FROM HERE. *********
14300	C   NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14400	1726	IF(V(IL-1).GT.-19000.)GO TO 2727
14500		RA=BT
14600		K=IL-1
14700	2726	V(K)=-9900.-RA
14800		ISUB=-1
14900		L=K+5
15000		RB=V(L)+V(L-1)
15100		V(L-1)=RA
15200		K=K+V(K+2)+2
15300		IF(V(K).GT.-19000.)GO TO 2727
15400		IF(V(K+1).NE.V(IL))GO TO 2727
15500		IF(V(K).NE.-9900.-RB)GO TO 2727
15600		RA=RA+V(L)
15700		CALL BGSORT(RA)
15800		GO TO 2726
15900	C  CONVERTS BG TIME OF NOTE NUM TO REAL TIME.  DOESN'T WORK WITH -66!
16000	C   NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
16100	732	DO 2606 K=NW,NWZ
16200	2606	BNW(K)=BNW(K+1)
16300		NWZ=NWZ-1
16400		IF(NWZ.EQ.0)GO TO 2111
16500		IF(NWZZ.EQ.1)GO TO 5111
16600		NWZZ=1
16700		IF(NWZ.EQ.1)GO TO 1111
16800		DO 3111 K=1,NWZ
16900		IF(BNW(K).LT.1000.)GO TO 3111
17000		X=BNW(NWZZ)
17100		BNW(NWZZ)=BNW(K)
17200		BNW(K)=X
17300		NWZZ=NWZZ+1
17400	3111	CONTINUE
17500	5111	IF(NWZZ.EQ.NWZ)GO TO 1111
17600		L=NWZZ+1
17700		X=BNW(NWZZ)
17800		DO 4111 K=L,NWZ
17900		IF(BNW(K).GT.X)GO TO 4111
18000		RA=BNW(K)
18100		BNW(K)=X
18200		X=RA
18300	4111	CONTINUE
18400		BNW(NWZZ)=X
18500		GO TO 1111
18600	111      FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18700		1'V ARRAY=',I4,'/2000',/' TEMPO FACTOR=',F6.2/)
18800	1023	FORMAT(/'  < ',A5,'.DAT  --  RANDOM NUMBER=',I6/1XA5)
18900	C********** BELOW IS FOR 'SECTIONS'
19000	9150	FORMAT(/3X'******* SECTION ',A1)
19100	2111	NWZ=-1
19200	C  ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
19300	1111	IF(MZ.EQ.0)GO TO 1601
19400	      IF(NWX.NE.1)GO TO 1486
19500	      WRITE(JOUT,111)ISLAC,IFLNM,I,TF
19600	C*********** JUNE 1,71
19700	C********** BELOW IS FOR 'SECTIONS'
19800	1486	IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19900		K=NWX-1
20000	C*********** JUNE 1,71
20100	        IF(NWX.LE.1)GO TO 377
20200		IF(IT(J).NE.-3)WRITE(JOUT,3154),K,Y  
20300	377	IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J) 
20400	C*********** JUNE 1,71    X 3     K'S
20500	
20600	      DO 602 K=1,NINS   
20700	48	LK=INST(K)
20800	C*********** JUNE 1,71
20900	  	IF(NCNT(K,31).EQ.10000)GO TO 477
21000		IF(NWX.GT.1)GO TO 602
21100	477	NCNT(K,31)=1
21200		IJ=IPT(K,31)
21300		X=0
21400		IF(IJ.NE.0)X=V(IJ+2)
21500	      WRITE(JOUT,5396),LK,X
21600		X=DUR(K)
21700	      IF(X.GT.10000.)GO TO 83 
21800	      WRITE(JOUT,8396),X     
21900		GO TO 602
22000	5396      FORMAT(5XA5,'  RANDOM TF =',F4.2,10X,'DURATION =',$) 
22100	7396      FORMAT('+',F5.0,' NOTES')    
22200	8396      FORMAT('+',F6.2,'"')   
22300	83      X=X-10000.
22400	      WRITE(JOUT,7396),X    
22500	602	CONTINUE
22600	715	IF(IT3.NE.1.)GO TO 1602
22700		RA=T1*TP
22800		RB=T2*TP
22900	      WRITE(JOUT,6154),RA,RB,TDUR  
23000	      IT3=0  
23100	1602	IF(NWX.EQ.1)GO TO 315
23200	      IF(IT(J).EQ.-3)GO TO 1108
23300	C*********** JUNE 1,71
23400	6154      FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
23500	7154	FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
23600	5154      FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
23700	902      FORMAT(1XA5/)  
23800	3154      FORMAT(/' <<   BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
23900	4154      FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)  
24000	C*********** JUNE 1,71
24100		IT(J)=IT(J)/10
24200		GO TO 1108
24300	315	IF(IT3.GT.1)WRITE(JOUT,7154),ICT
24400		IF(OP1.NE.0)WRITE(JOUT,4154),OP1 
24500	1601  IF(NWX.GT.1) GO TO 1108
24600		IF(TF.GT.10.)TF=TF/60.
24700		TF=1000./TF
24800		DO 6015 K=1,30
24900	6015	COPY(K)=-9900.
25000	C  INITS PARAM REPRESSION FEATURE.
25100	      IF(KB.EQ.0)GO TO 9926   
25200	      ML=NINS+1   
25300	      NL=NINS+KB
25400	      DO 9826 K=ML,NL   
25500	      BW=OTH(K-NINS,1) 
25600		IF(BW.NE.-99)GO TO 9826
25700		K=K-NINS
25800		GO TO 5741
25900	C  'INSERT -99;' COMES BEFORE 'PLAY;'
26000	9726	BW=19999.
26100		K=K+NINS
26200	9826	BG(K)=BW
26300	C   'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1   
26400	9926      DO 5015 K=1,NINS    
26500		IQ(K)=BG(K)*10000.
26600	      BG(K)=0
26700		INP(K)=0
26800	      P1(K)=0     
26900		IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
27000	C******* FEB. 16,71   FOR ROUND-OFF NONSENSE
27100	5015      CNT(K)=0
27200		IF(MZ)WRITE(JOUT,1023),ISLAC,IXIN,PLAY
27300		IF(MX)WRITE(1,1023)ISLAC,IXIN,PLAY
27400	      BW=0 
27500		GO TO 500
     

00100	752      FORMAT(1X15A5)
00200	1108      M=0 
00300	      JC=0  
00400		IF(NWZ)GO TO 1740
00500	C  NWZZ IS SET AT 3111 IN SORTR.
00600		DO 740 K=1,NWZZ
00700	      X=BNW(K)    
00800		IF(X-.0001.GT.BT)GO TO 2740
00900		IF(X.LE.BW)GO TO 2740
01000		IF(BW)GO TO 2740
01100		IT(J)=IT(J)*10
01200	      NW=K  
01300	      GO TO 600   
01400	2740	IF(X.LT.1000.)GO TO 740
01500		IF(X-J*10000.NE.CNT(J)+1.)GO TO 740
01600	      X=BT+PR     
01700	      NW=K  
01800		BX=CNT(J)+1.
01900	      IT(J)=-3    
02000	      GO TO 600   
02100	740      CONTINUE 
02200	      IT(J)=0     
02300	1740      IF(J.LE.NINS)GO TO 31   
02400	7021      K=J-NINS
02500	      IF(JC.GT.0)K=JC   
02600	5740      IF(PP1.LT.OP1)GO TO 1752 
02700	5741  IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)    
02800	      IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)     
02900	C   IF TF .NE.1, ALL  INSERT TIMES MUST BE RESET
03000	C   IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR  'INSERTS'.  
03100		DO 17521 L=3,30
03200	17521	COPY(L)=-9900.
03300	C  SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03400	1752	BG(K+NINS)=19999.
03500		OTH(K,1)=19999.
03600		IF(BW.EQ.-99)GO TO 9726
03700	      IF(JC.GT.0)GO TO 21     
03800	31      KL=1
03900	      IF(KB.EQ.0)GO TO 2031   
04000	      DO 1031 L=1,KB    
04100		K=L
04200	      X=OTH(K,1)-1000000.     
04300	      M=X/100000. 
04400	      IF(M.NE.J)GO TO 1031
04500		IF(IQ(J).NE.0)GO TO 1031   
04600	C   M=INST  
04700	      IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740 
04800	1031	CONTINUE
04900		IF(J.GT.NINS)GO TO 500
05000	2031      CNT(J)=CNT(J)+1   
05100	      ICT=CNT(J)  
05200	C   INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
05300	      NPA=NP(J)   
05400	      PP1=P1(J)  
05500	      IF(BT.GE.DUR(J))GO TO 5174    
05600		IF(IQ(J).EQ.0)GO TO 200
05700		P2=-IQ(J)/10000.
05800		IQ(J)=0
05900		CNT(J)=-1
06000		ICT=-1
06100		GO TO 4203
06200	
06300	C   MK IS FLAG FOR RESTS
06400	200	MK=0
06500	      IF(BT.NE.0)GO TO 577
06600		IF(J.EQ.1)GO TO 203
06700	577	IF(IPT(J,1).EQ.0)GO TO 203    
06800		KN=IPT(J,1)-1
06900		IF(KN.GT.0)GO TO 12033
07000	12032	KN=JPT(-KN)
07100		IF(KN)GO TO 12032
07200		KN=KN-1
07300	C  FOR 'ALL' IN P32.  FOLLOWS UP ON POINTERS TO POINTERS!
07400	C   SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
07500	12033	IJ=V(KN)
07600		IF(ABS(V(KN)).EQ.4.)GO TO 1203
07700	C   'IABS' IS FOR -4 USED WITH 'ALL'
07800	  	Z=(BT+9900.+V(KN-2))/V(KN+2)
07900	C******* FEB 19,71
08000		IF(Z.GT.1.)Z=1.
08100		Y=V(KN+3)
08200		X=(V(KN+4)-Y)*Z+Y
08300	C******* FEB 19,71
08400		GO TO 204
08500	1203	X=V(KN+3)
08600	204	Y=RAND(0.0,1.0)
08700		IF(Y-X)MK=-1
08800	
08900	203	DF=1.
09000	C   DF=DUTY FACTOR 
09100		DO 2155 L=2,NPA
09200		ISUB=0
09300	C  WHY DOES ISUB APPEAR AT 14700/5?
09400		IDF=0 
09500	C    IDF IS DUTY FACTOR FLAG
09600		IJ=IPT(J,L)
09700	12031	IF(IJ)IJ=JPT(-IJ)
09800		IF(IJ)GO TO 12031
09900	C  FOLLOWS UP ON POINTERS TO POINTERS!
10000		PM=1.
10100		IF(IJ.GT.1)GO TO 2157
10200		P(L)=0
10300		GO TO 21551
10400	C 7/73
10500	2157	LN=IJ+2
10600		NM=ABS(V(IJ-1))+LN-4
10700		NL=V(IJ)
10800		IF(NL.GT.-100)GO TO 272
10900		IF(NL.GT.-200)GO TO 372
11000		ISUB=-1
11100		NL=NL+200
11200	C FOR SUBROUTINE FLAG
11300	372	IF(NL.GT.-100)GO TO 272
11400		IDF=-1
11500		NL=NL+100
11600	C  DEC.6,72  FINDS DUTY FACTOR PARAM
11700	272	VIJ2=V(IJ+1)
11800		KN=NL/(-11)
11900		IF(KN.EQ.0)GO TO 1100
12000		GO TO (61,62,62,62,65,65,67,68),KN
12100	1100	IF(VIJ2.EQ.1.)GO TO 1200
12200		ML=3
12300	1900	KA=1
12400		VX1=0
12500		DO 1156 K=LN,NM,ML
12600		VX(KA+1)=V(K)+VX(KA)
12700	1156	KA=KA+1
12800		X=RAND(0.0,1.)
12900		DO 1157 K=2,11
13000		IF(X.GT.VX(K))GO TO 1157
13100		KL=K-1
13200		IF(KN.EQ.7)GO TO 6157
13300		GO TO 1400
13400	1157	CONTINUE
13500	1400	LN=IJ+3*KL
13600	1462	RA=V(LN)
13700		IF(RA.EQ.10000.)GO TO 5174
13800	C   FOR "FINE" IN RLIST
13900		RB=V(LN+1)
14000		PAR=RAND(RA,RB)
14100	1300	IF(NL.NE.-1)PM=2.
14200	C  IF 2 THEN PRINTS A5
14300		GO TO 1155
14400	1200	PAR=V(IJ+2)
14500		GO TO 1300
14600	C   NEXT IS FOR SUBROUTINE AND QUAD CALLS
14700	61	IF(NL.LT.-12)GO TO 6100
14800	601	X=P2
14900	C  '.5' MAKES ALL SUBR PARAMS PRINTOUT.
15000		CALL SUBR
15100	CC 7/74 NOW SET DUR(J) =0 IN SUBR	IF(DF)GO TO 5174
15200	C* OUT--COLGATE  DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
15300		IF(L.EQ.2)GO TO 4203
15400		IF(X.EQ.P2)GO TO 21552
15500		PP2=P2
15600		PR=P2
15700		GO TO 21552
15800	C  ABOVE IS FOR P2 CHANGES IN SUBROUTINE
15900	C  TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
16000	C  ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
16100	C  BE SET TO 'REAL TIME'.)
16200	
16300	C   NEXT IS FOR QUAD ROUTINES
16400	6100	CALL QUAD(NL)
16500		GO TO 21552
16600	
16700	C   FOLLOWING IS FOR STRINGS OF VALUES.  
16800	62      KL=NCNT(J,L)+1
16900		IF(KL.GT.VIJ2)KL=1 
17000		IF(NL.EQ.-46)GO TO 677
17100		IF(NL.NE.-36)GO TO 162
17200	C   THIS PART FOR STRINGS OF RAND SELECTION
17300	677	LN=KL+IJ+1
17400		KL=KL+1
17500		IF(KL.GT.VIJ2)KL=1 
17600		NL=NL+45
17700	C   FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1.  FOR NOTES, =9)
17800	162	NCNT(J,L)=KL
17900		IF(NL.GT.-22)GO TO 1462
18000	C   JUMP RAND SELECTION
18100	      PAR=V(IJ+KL+1)
18200	C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
18300	C************************
18400		IF(KN.NE.3)GO TO 1155
18500	C*******JULY 16,71	IF(PAR.EQ.101.)GO TO 5174
18600		IF(PAR.EQ.10000.)GO TO 5174
18700		PM=2.
18800		IF(PAR.GT.100.)GO TO 777
18900		IF(PAR.GE.1.)GO TO 877
19000	777	PM=3.
19100	877	IF(PAR.EQ.85.)MK=-1
19200	      GO TO 5155  
19300	65	W=-9900.-V(IJ-3)
19400	C  W=BG TIME OF MOVE.
19500		X=ABS(V(IJ-1))
19600		IF(NL.EQ.-56)GO TO 977
19700		IF(NL.NE.-58)GO TO 771
19800	977	PM=2.
19900	771	Z=(BT-W)/VIJ2
20000	C  Z= % OF WAY THROUGH.
20100		IF(Z.GT.1.)Z=1.
20200		Y=V(LN)
20300		W=V(IJ+3)
20400		IF(X.EQ.7.)W=V(IJ+4)
20500		IF(NL.LT.-58)GO TO 16002
20600		PAR=(W-Y)*Z+Y
20700		IF(X.EQ.7.)GO TO 1600
20800		GO TO 1155
20900	C************** JUNE 1,71
21000	C   FOR "MOVX"
21100	C******** FEB/73
21200	C  THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
21300	16002	PAR=RMOVX(W,Y,Z)
21400	C  SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
21500	C  THIS NEEDS WORK!
21600		IF(X.NE.7.)GO TO 1155
21700		W=V(IJ+5)
21800		Y=V(IJ+3)
21900		X=RMOVX(W,Y,Z)
22000		GO TO 16003
22100	C  NEXT IS FOR MOVING RAND RANGES.
22200	C1600	PAR=(V(IJ+4)-Y)*Z+Y
22300	1600	W=V(IJ+3)
22400	C*********** BACK TO 65 IS NEW.   FEB. 15,71
22500		X=(V(IJ+5)-W)*Z+W
22600	C************ JUNE 1,71   
22700	16003	PAR=RAND(PAR,X)
22800		GO TO 1155
22900	67	LN=IJ+3
23000		NM=LN+VIJ2-1
23100		ML=1
23200		GO TO 1900
23300	4155	K=(PAR-9999.0)*100.+.1	
23400		P(L)=P(K)
23500		IF(L.NE.2)GO TO 772
23600		IF(K.EQ.2)P2=PX2
23700	C  PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
23800	772	PM=PL(K)
23900		GO TO 21551
24000	C   ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
24100	C 7/74  **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
24200	C ALSO DF.  THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
24300	C  CHANGES.  HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
24400	C  INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
24500	6157	LN=V(LN-1)
24600		DO 1068 K=1,KL
24700	1068	IF(K.LT.KL)LN=LN+V(LN)+1
24800	2068	PM=LN+1
24900		PAR=LN+V(LN)
25000		GO TO 5155
25100	68	KL=NCNT(J,L)
25200		IF(KL.EQ.0)GO TO 774
25300		IF(KL.NE.10000)GO TO 773
25400	774	KL=VIJ2
25500	773	PM=KL+1
25600		PAR=PM+V(KL)-1
25700		KL=PAR+1
25800		IF(V(KL).EQ.10000.)DUR(J)=BT
25900	C  'END' OR 'FINE' IN 'LIT' LIST.
26000		IF(V(KL).EQ.999.)KL=IJ+2
26100		NCNT(J,L)=KL
26200		GO TO 5155
26300	C ******* JAN 20  *************
26400	1155	IF(PAR.EQ.10000.)GO TO 5174
26500	C  TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
26600		IF(PAR.LE.9999.)GO TO 5155
26700		IF(PM.EQ.1.)GO TO 4155
26800	C****JULY 16,71 1155	IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
26900	5155	P(L)=PAR
27000	21551	PL(L)=PM
27100		IF(ISUB)GO TO 601
27200		IF(L.EQ.2)GO TO 4203
27300	21552	IF(IDF.GE.0)GO TO 2155
27400		DF=PAR
27500	C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
27600		IDF=0
27700	2155	CONTINUE
27800	
27900	9203      IF(KB.EQ.0)GO TO 1170     
28000	       NL=KB
28100	      DO 2203 K=1,KB    
28200	      X=OTH(NL,1) 
28300	      IF(X.LT.100000.)GO TO 2203     
28400	      L=X/100000.
28500	      Y=(X-L*100000.)/100.    
28600	      IX=Y  
28700	      JC=NL 
28800	      IF(J.NE.L)GO TO 2203
28900		IF(IX.EQ.ICT)GO TO 5203    
29000	2203  NL=NL-1     
29100	      GO TO 1170  
29200	4203      PR=P2 
29300		PX2=P2
29400	C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
29500	      IF(T5.EQ.0)GO TO 7203   
29600		IF(IT3.LE.1)GO TO 6203
29700		IF(BT.LT.TBG+TDUR)GO TO 6203
29800	3155	IT3=IT3+3
29900		TBG=TBG+TDUR
30000		TDUR=V(IT3)
30100		IF(BT.GE.TBG+TDUR)GO TO 3155
30200		T1=V(IT3+1)
30300		T2=V(IT3+2)
30400		CALL SQYY(AC,T1,T2,TDUR)
30500	6203	RA=PR 
30600		IF(BT.EQ.TBG)XT(J)=T1
30700		K=IT3
30800		RC=0  
30900		RD=1  
31000		KA=1  
31100		RB=0  
31200		Z=TDUR+TBG-BT	
31300		X=T1  
31400		Y=T2  
31500		YY=AC
31600		CHN=TBG	
31700		ZZ=TDUR	
31800	      CALL ACCEL
31900	8203	P2=RA*RD    
32000	7203	P2=P2*T4
32100		X=P2*TF
32200	C  P2 IS KEPT WITHOUT TF*
32300		K=X+.5
32400		IF(X)K=X-.5
32500	72031	ROFF(J)=ROFF(J)+K-X
32600		IF(ABS(ROFF(J)).LT.1.)GO TO 7155
32700		Y=1.
32800		IF(ROFF(J))Y=-1.
32900		K=K-Y
33000		ROFF(J)=ROFF(J)-Y
33100	C  ROUND-OFF GAP WILL NOT EXCEED .001
33200	C*********** FEB 17,71
33300	7155	PP2=K/1000.
33400	C   AVOIDS ROUND-OFF PROBLEMS
33500	C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
33600		IF(IPT(J,31).EQ.0)GO TO 6155
33700		IF(ICT)GO TO 1170
33800		X=V(IPT(J,31)+2)/2.
33900		Y=RAND(-X,X)
34000		IF(PP2.GE.0)GO TO 615
34100		MK=-1
34200		PP2=-PP2
34300	615	PP2=PP2-RDEV(J)+Y
34400		RDEV(J)=Y
34500	C  TOTAL RAND DEV. WON'T EXCEED P31
34600	C  SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
34700	
34800		K=PP2*1000.+.5
34900	C****** CHECK THIS OUT  1/10/72 :::::::
35000	61551	PP2=K/1000.
35100	C   NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
35200	6155	IF(ICT)GO TO 9203
35300		GO TO 2155
35400	5203      JD=Y*100-IX*100+.5  
35500	      IF(JD.GT.0)GO TO 3203   
35600		M=0
35700		P1(J)=PP1+PP2
35800	      GO TO 7021  
35900	3203      P(JD)=OTH(JC,2)     
36000		X=OTH(JC,3)
36100		IF(X.NE.1.)X=3.
36200	C   'EDITS' PRINT,NUM. OR 5 CHARS.
36300	      PL(JD)=X
36400	C   NEXT ADDED NOV.72  CHECK FOR SIDE AFFECTS !!!!! **********
36500		IF(JD.EQ.2)PP2=P2
36600	C   'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
36700	1170      IF(MK)GO TO 2022
36800		IF(PP2)GO TO 2022   
36900	
37000		ZPAR=PP1
37100		P1(J)=PP1+PP2
37200	C   ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
37300		LK=INST(J)
37400	2021	IF(PP1.LT.OP1)GO TO 2612
37500		IF(INVIS(J).LT.0)GO TO 2170
37600	C  ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
37700		IF(INONLY.GT.0)GO TO 1204
37800	C*********** MAY 16,71 ↑↑↑
37900	6021	IF(P(NPA).NE.COPY(NPA))GO TO 5021
38000		IF(PL(NPA).GT.1)GO TO 5021
38100	C******* MAY 25,71
38200	C  'LIT' DATA WILL ALWAYS PRINT.
38300		NPA=NPA-1
38400		IF(NPA.GT.2)GO TO 6021
38500	5021	DO 1304 K=3,NPA
38600	1304	COPY(K)=P(K)
38700	1204	IF(PL4.NE.1.)GO TO 2170
38800		P4=P4*AMPFAC
38900		L=0
39000		INP(J)=P4
39100		DO 1021	K=1,NINS
39200	1021	IF(P1(K).GT.PP1)L=L+INP(K)
39300		IF(L-IAMP-1)GO TO 2170
39400		IAMP=L
39500		AMPTIM=PP1
39600	2170	IF(MX.EQ.3)GO TO 2612
39700	C ********* MAY 17,71
39800	      PP1=PP1-OP1     
39900	C   PUTS SPACES BETWEEN NOTES .GT. .05( APART
40000		IF(MZ.NE.-1)GO TO 5170
40100		IF(A.GE.PP1)GO TO 5170
40200		IF(INONLY)WRITE(JOUT,902)
40300		A=PP1+.05
40400	5170	ML=10
40500		IF(NPA.LT.10)ML=NPA
40600		MLX=3
40700		NL=2
40800		IF(INVIS(J).EQ.0)GO TO 3170
40900		LK=0
41000	C  NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
41100	C  NEXT CREATES FORMAT DATA IN IFM ARRAY.
41200	31701	KL=3
41300		GO TO 4170
41400	3170	IF(J.EQ.INONLY)GO TO 775
41500		IF(.NOT.INONLY)GO TO 2612
41600	775	VX(1)=PP1
41700		IF(DF.GT.0)GO TO 6170
41800		VX2=-DF
41900		IF(VX2.GT.PP2)VX2=PP2
42000	C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2   7/74 COLGATE  -AND BELOW
42100		GO TO 7170
42200	6170	IF(DF.LT.100)GO TO 8170
42300	C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
42400		VX2=PP2-DF+100.
42500		IF(VX2.LE.0)VX2=PP2/2.
42600	C NO NEG. TIME VALUES ALLOWED.
42700		GO TO 7170
42800	8170	VX2=PP2*DF
42900	7170	IFM3='F9.3,'
43000		IFM4=IFM3
43100		KL=5
43200		IF(NPA.LT.3)GO TO 2121
43300	
43400	4170	NL=2
43500		DO 1121 K=MLX,ML
43600		X=P(K)
43700		L=PL(K)
43800		IF(L-2)321,521,621
43900	C  L=1 NUMBS,  =2 NOTES,FUNCS,  =3 LITS.
44000	321	IF(X.GE.0)GO TO 4211
44100		IFM(KL)=IFCOM
44200		NL=NL+1
44300		KL=KL+1
44400	4211	IFM(KL)='F9.3,'
44500	C   CREATES 'F9.3'
44600	421	VX(KL-NL)=X
44700		GO TO 1121
44800	521	IFM(KL)=IFM2
44900	C   CREATES '1XA5'
45000		LN=X
45100		VX(KL-NL)=SCAL(LN)
45200		GO TO 42
45300	621	IF(L.GT.3)GO TO 721
45400		VX(KL-NL)=X
45500	C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
45600	42	IFM(KL)=IFM2
45700		GO TO 1121
45800	721	LN=X
45900		IFM(KL)=I1X
46000		NL=NL+1
46100		DO 821 M=1,LN-L+1
46200		KL=KL+1
46300		IOUT(KL-NL)=IV(L-1+M)
46400	821	IFM(KL)=IA1
46500	1121	KL=KL+1
46600	
46700	C  NO MORE THAN 80 ITEMS IN FORMAT.
46800	2121	IF(KL.LE.80)GO TO 21211
46900	21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
47000		TYPE 21212
47100	21211	DO 921 M=KL+1,80
47200	921 	IFM(M)=IBLA
47300		IFM(KL)=')'
47400		L=KL-NL-1
47500		IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
47600		IF(.NOT.MZ)GO TO 30210
47700		IF(ML.GE.NPA)IFM(KL)='$)'
47800		WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
47900	30210	IF(ML.GE.NPA)GO TO 3021
48000		MLX=ML+1
48100		ML=ML+10
48200		IF(ML.GT.NPA)ML=NPA
48300		LK=IBLA
48400		GO TO 31701
48500	3021	IF(MX)WRITE(1,3616)INST(J),ICT
48600	30211	IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
48700	2612      PP1=ZPAR     
48800	         GO TO 21 
48900	8902	FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
49000	3616	FORMAT(';PRINT(P1);< ',A5,I4)
49100	C   PRINTS RESTS  
49200	2022	PP2=ABS(PP2)
49300	C   IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2. 
49400	C   FOR RESTS IN SEQS. TYPE -DUR.   
49500	C   WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
49600	C    RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
49700		INP(J)=0
49800		P1(J)=PP1+PP2
49900	C   STORES NEXT P1 TIME FOR THIS INST.
50000		IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21   
50100	      X=PP1-OP1  
50200		IF(A.GE.X)GO TO 121
50300		WRITE(JOUT,902)
50400		A=X+.05
50500	121	IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
50600		1 J,INST(J),ICT
50700	21	PR=ABS(PR)
50800	      BG(J)=BT+PR 
50900	      IF(ICT.EQ.DUR(J)-10000.)GO TO 5174 
51000	      IF(BG(J).LT.DUR(J))GO TO 500  
51100	5174      BG(J)=19999. 
51200	      DO 3174 K=1,NINS  
51300	C   INSERTS CANT FOLLOW LAST REGULAR NOTE.
51400	C   (ADD REST IF INSERT AT END IS NEEDED.)    
51500	3174      IF(BG(K).LT.19999.)GO TO 500     
51600	      GO TO 175   
51700	C   CHOOSES INST WITH NEXT BEGIN TIME.    
51800	500      J=1   
51900		BW=BT
52000	      NL=NINS+KB
52100	      DO 22 K=2,NL
52200	22      IF(BG(J).GT.BG(K))J=K 
52300		IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
52400		J=1
52500		DO 5022 K=2,NINS
52600		X=P1(J)
52700		Y=P1(K)+.0001
52800	C  LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
52900		IF(BG(J).EQ.19999.)X=19999.
53000		IF(BG(K).EQ.19999.)Y=19999.
53100	5022	IF(X.GT.Y)J=K
53200	C   ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
53300	3022      BT=BG(J)    
53400	      IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
53500		IF(CNT(J).GT.0)GO TO 1022
53600	      IF(CNT(J).EQ.0)P1(J)=0  
53700	      IF(CNT(J).EQ.-1)CNT(J)=0
53800	C   N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0   
53900	1022      IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108    
54000	      T4=T2 
54100	      T5=0  
54200	      T6=10000.   
54300	      GO TO 1108    
54400	1175	FORMAT('+',A5,'=',F7.3,2X,$)
54500	1109	FORMAT(' FINISH; < ',A5,'.DAT')
54600	1110	FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
54700	1603  FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I4,', AT TIME'
54800		1,F8.3)
54900	175	IF(MZ)WRITE(JOUT,1109),ISLAC
55000		IF(MX.GE.0)GO TO 4175
55100		WRITE(1,1109),ISLAC
55200		END FILE 1
55300	603	FORMAT(' TOTAL DURS:  ',$)
55400	CC FOR COLGATE ONLY***4175	CALL ENDSUB
55500	C  CLEARS CNTL O --- IF YOU HAVE HIT IT.
55600	4175	WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
55700		WRITE(JOUT,603)
55800	5175	DO 2175 K=1,NINS
55900		X=P1(K)-OP1
56000		IF(MZ)GO TO 6175
56100		TYPE 1175,INST(K),X
56200		GO TO 2175
56300	6175	WRITE(JOUT,1175),INST(K),X
56400	2175	CONTINUE
56450		IF(JOUT.NE.22)GO TO 3175
56460		END FILE 22
56470		CALL PRINT
56480		REWIND 22
56490		K='FOR22'
56495		CALL OFILE(22,K)
56497		END FILE 22
56500	3175	TYPE 1023,ISLAC,IXIN
56600	      CALL EXIT
56700	      END